perm filename DCCVT.FAI[D,SYS] blob
sn#258998 filedate 1977-01-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE DCCVT CONVERT I/O INSTR FOR DEVICE 200 TO DEVICE 204
C00004 00003 MAIN:
C00005 00004 READ FILE SPECS FROM TTY INTO BLOCK
C00010 00005 GET WORD FROM DKIC FILE INTO I
C00011 00006 SAVPPN: 0 HAS CURRENT DSK PPN
C00012 ENDMK
C⊗;
TITLE DCCVT CONVERT I/O INSTR FOR DEVICE 200 TO DEVICE 204
F←0
A←1
B←2
C←3
D←4
E←5
G←6
T←7
TT←10
I←11
J←12
K←13
L←14
M←15
N←16
P←17
DKIC←←1
DKOC←←2
DEFINE CRLF
< OUTCHR [15]
OUTCHR [12]
>
DEFINE GETFIL $ (LE,STR,LH,CH,BUF,BYTE)
<ZZ←←.
IFDIF <STR><><OUTSTR [ASCIZ /$STR$/]>
PUSHJ P,FILSCN ;INPUT FILE SPECS
IFIDN <LE> <L> <LH,,LUP>
IFIDN <LE> <E> <LH,,ENT>
JRST [ CRLF ;ALT TYPED
JRST MAIN]
JRST [ OUTSTR [ASCIZ /??
/] ;GARBAGE TYPED
CLRBFI
JRST ZZ]
INIT CH,10
'DSK '
IFIDN <LE> <E> <BUF,,> IFIDN <LE> <L> <BUF>
JRST INITL
IFIDN <LE> <L> <LOOKUP CH,LUP
JRST [ PUSHJ P,LUPFL
JRST ZZ]>
IFIDN <LE> <E> <ENTER CH,ENT
JRST [ PUSHJ P,ENTFL
JRST ZZ]>
MOVEI A,BYTE
DPB A,[300600,,BUF+1]
>
MAIN:
GO: RESET
MOVE P,[-20,,PDL-1]
GETFIL (L,IN FILE=,'DMP',DKIC,IBUF,=36)
GETFIL (E,OUT FILE=,'DMP',DKOC,OBUF,=36)
MOVEI B,74 ;ADDRESS COUNTER
LOOP: PUSHJ P,GETIN
MOVE A,I
XOR A,[CONO 200,]
TLNN A,777400
TLC I,400
PUSHJ P,PUT
CAIGE B,37777
AOJA B,LOOP
OUTSTR [ASCIZ /
DONE
/]
EXIT
;READ FILE SPECS FROM TTY INTO BLOCK
;WORD AFTER CALL IS DEFAULT EXTENSION,,BLK ADDRESS.
;DOESNT SKIP IF ALT MODE TYPED.
;SKIPS ONCE IF SYNTAX ERROR, TWICE IF OK.
FILSCN: MOVE L,@(P)
HLLZM L,1(L) ;SET UP DEFAULT EXTENSION
AOS (P)
MOVE I,SAVPPN
MOVEM I,3(L) ;INITIALIZE TO CURRENT DSK PPN
PUSHJ P,GETSIX ;SYMBOL IN J, SEPARATOR IN I
CAIN I,175 ;ALT MODE
POPJ P,
AOS (P)
MOVEM J,(L)
CAIN I,"."
JRST FILSCX ;GET EXTENSION
CAIN I,"["
JRST FILSCP ;GET PPN
CAIN I,12
POPJ1: AOS (P)
CPOPJ: POPJ P,
FILSCX: PUSHJ P,GETSIX
HLLZM J,1(L)
CAIN I,12
JRST POPJ1
CAIE I,"["
POPJ P,
FILSCP: PUSHJ P,GETSIX
JUMPE J,FILSP3
FILSP1: TLNE J,77 ;RIGHT ADJUST
JRST FILSP2
LSH J,-6
JRST FILSP1
FILSP2: HLLM J,3(L) ;STORE PROJ NUMBER
FILSP3: CAIN I,","
JRST FILSP4 ;GET PROGRAMMER NAME
FILSP8: CAIN I,"]"
JRST FILSP5 ;DONE
CAIN I,12
AOS (P)
POPJ P,
FILSP4: PUSHJ P,GETSIX
JUMPE J,FILSP8
FILSP6: TLNE J,77
JRST FILSP7
LSH J,-6
JRST FILSP6
FILSP7: HLRM J,3(L)
JRST FILSP8
FILSP5: PUSHJ P,GETSIX
CAIN I,12
JRST POPJ1
JRST FILSP5
LUPFL: OUTSTR [ASCIZ /LOOKUP FAILED - /]
MOVEI L,LUP
FILNOU: MOVE I,(L)
PUSHJ P,SIXTYP
OUTCHR ["."]
MOVE I,1(L)
PUSHJ P,SIXTY3
OUTCHR ["["]
MOVE I,3(L)
PUSHJ P,SIXTY3
OUTCHR [","]
MOVS I,3(L)
PUSHJ P,SIXTY3
OUTSTR [ASCIZ /]
/]
POPJ P,
ENTFL: OUTSTR [ASCIZ /ENTER FAILED - /]
MOVEI L,ENT
JRST FILNOU
;GET SIXBIT SYLLABLE IN J WITH SEPARATOR IN I
GETSIX: MOVE K,[440600,,J]
SETZB F,J
GETSX1: INCHWL I
CAIN I,15
JRST GETSX1
CAIL I,"0"
CAILE I,"9"
JRST GETSX2 ;NOT NUM
JRST GETSX3 ;NUMBER
GETSX2: CAIL I,"a"
CAILE I,"z"
JRST GETSX4 ;NOT LOWER CASE
JRST GETSX5 ;LOWER CASE
GETSX4: CAIL I,"A"
CAILE I,"Z"
JRST GETSX6
GETSX3: SUBI I,40
GETSX5: TLNE K,770000
IDPB I,K
JRST GETSX1
GETSX6: CAIN I,"↓"
JRST GETSX7
TRNN F,1
POPJ P,
JRST GETSX5
GETSX7: XORI F,1
JRST GETSX1
;TYPE I IN SIXBIT (6 CHARS WORTH)
SIXTYP: MOVE J,[440600,,I]
SIXTY1: ILDB K,J
ADDI K,40
OUTCHR K
TLNE J,770000
JRST SIXTY1
POPJ P,
;TYPE LEFT 3 CHARS OF I
SIXTY3: MOVE J,[440600,,I]
SIXTY4: ILDB K,J
ADDI K,40
OUTCHR K
TLNE J,500000
JRST SIXTY4
POPJ P,
INITL: OUTSTR [ASCIZ /CAN'T INIT DSK - LOSEY, LOSEY
/]
JRST 4,.
GETNUM: SETZM MINUSF
MOVEI A,0
GETNM1: INCHWL B
CAIN B,"-"
JRST [SETOM MINUSF ↔ JRST GETNM1]
CAIN B,15
JRST GETNM1
CAIN B,12
JRST GETNMX
CAIN B,175
JRST POPJ1
CAIL B,"0"
CAILE B,"7"
POPJ P,
LSH A,3
ADDI A,-"0"(B)
AOJA C,GETNM1
GETNMX: SKIPGE MINUSF
MOVNS A
POPJ2: AOS (P)
JRST POPJ1
OCTTYP: PUSH P,G
MOVEI G,10
JRST DECTY
DECTYP: PUSH P,G
MOVEI G,=10
DECTY: PUSH P,D
PUSH P,E
PUSHJ P,DECTY1
POP P,E
POP P,D
POP P,G
POPJ P,
DECTY1: IDIVI D,(G)
HRLM E,(P)
SKIPE D
PUSHJ P,DECTY1
HLRZ E,(P)
ADDI E,"0"
OUTCHR E
POPJ P,
;GET WORD FROM DKIC FILE INTO I
;SKIP RETURNS UNLESS EOF
ZZ←←0
DEFINE GETGEN $ (DKIC,GETIN,IBUF)
<
GETIN$R: SOSG IBUF+2
IN DKIC,
JRST GETIN$1
STATZ DKIC,20000 ;EOF?
POPJ P, ;YES
JRST 4,. ;NO
GETIN$1: ILDB I,IBUF+1
JRST POPJ1
GETIN: PUSHJ P,GETIN$R
JRST GETEOF
POPJ P,
GETIN$B: PUSHJ P,GETIN
IFG ZZ,<JRST GTINB1>
IFE ZZ,<ZZ←←ZZ+1
GTINB1: LSH I,=24
ASH I,-=24
POPJ P,>
>
GETGEN (DKIC,GETIN,IBUF)
GETEOF: OUTSTR [ASCIZ /
EOF ON INPUT
/]
CLOSE DKOC,
EXIT
PUT: SOSG OBUF+2
OUT DKOC,
JRST PUT1
JRST 4,.
PUT1: IDPB I,OBUF+1
POPJ P,
SAVPPN: 0 ;HAS CURRENT DSK PPN
LUP: BLOCK 4
ENT: BLOCK 4
IBUF: BLOCK 3
OBUF: BLOCK 3
MINUSF: 0
PDL: BLOCK 20
END GO